Exploring Raw Features with RRPlot
convar <- colnames(dataFL)[lapply(apply(dataFL,2,unique),length) > 10]
convar <- convar[convar != "time"]
topvar <- univariate_BinEnsemble(dataFL[,c("status",convar)],"status")
pander::pander(topvar)
topv <- min(5,length(topvar))
topFive <- names(topvar)[1:topv]
topFeature <- RRPlot(cbind(dataFL$status,dataFL[,topFive[1]]),
title=topFive[1])


par(op)
## With Survival Analysis
RRanalysis <- list();
idx <- 1
for (topf in topFive)
{
RRanalysis[[idx]] <- RRPlot(cbind(dataFL$status,dataFL[,topf]),
timetoEvent=dataFL$time,
atRate=c(0.90,0.80),
title=topf)
idx <- idx + 1
par(op)
}












names(RRanalysis) <- topFive
Reporting the Metrics
pander::pander(t(RRanalysis[[1]]$keyPoints),caption="Threshold values")
Threshold values
| Thr |
73.000 |
69.000 |
68.000 |
54.000 |
50.00000 |
| RR |
4.013 |
4.399 |
4.448 |
5.662 |
1.00000 |
| RR_LCI |
3.740 |
4.045 |
4.087 |
4.500 |
0.00000 |
| RR_UCI |
4.305 |
4.783 |
4.842 |
7.125 |
0.00000 |
| SEN |
0.581 |
0.713 |
0.721 |
0.964 |
1.00000 |
| SPE |
0.883 |
0.790 |
0.785 |
0.232 |
0.00526 |
| BACC |
0.732 |
0.752 |
0.753 |
0.598 |
0.50263 |
ROCAUC <- NULL
CstatCI <- NULL
RRatios <- NULL
LogRangp <- NULL
Sensitivity <- NULL
Specificity <- NULL
for (topf in topFive)
{
CstatCI <- rbind(CstatCI,RRanalysis[[topf]]$c.index$cstatCI)
RRatios <- rbind(RRatios,RRanalysis[[topf]]$RR_atP)
LogRangp <- rbind(LogRangp,RRanalysis[[topf]]$surdif$pvalue)
Sensitivity <- rbind(Sensitivity,RRanalysis[[topf]]$ROCAnalysis$sensitivity)
Specificity <- rbind(Specificity,RRanalysis[[topf]]$ROCAnalysis$specificity)
ROCAUC <- rbind(ROCAUC,RRanalysis[[topf]]$ROCAnalysis$aucs)
}
rownames(CstatCI) <- topFive
rownames(LogRangp) <- topFive
rownames(Sensitivity) <- topFive
rownames(Specificity) <- topFive
rownames(ROCAUC) <- topFive
pander::pander(ROCAUC)
| age |
0.822 |
0.810 |
0.833 |
| kappa |
0.682 |
0.667 |
0.697 |
| lambda |
0.665 |
0.650 |
0.680 |
| creatinine |
0.594 |
0.578 |
0.610 |
pander::pander(CstatCI)
| age |
0.775 |
0.775 |
0.763 |
0.785 |
| kappa |
0.671 |
0.671 |
0.659 |
0.684 |
| lambda |
0.657 |
0.657 |
0.645 |
0.670 |
| creatinine |
0.589 |
0.590 |
0.575 |
0.603 |
pander::pander(LogRangp)
| age |
0.00e+00 |
| kappa |
4.90e-175 |
| lambda |
4.41e-145 |
| creatinine |
2.67e-67 |
pander::pander(Sensitivity)
| age |
0.581 |
0.558 |
0.602 |
| kappa |
0.319 |
0.298 |
0.340 |
| lambda |
0.300 |
0.279 |
0.321 |
| creatinine |
0.288 |
0.269 |
0.309 |
pander::pander(Specificity)
| age |
0.883 |
0.873 |
0.892 |
| kappa |
0.900 |
0.891 |
0.908 |
| lambda |
0.899 |
0.890 |
0.907 |
| creatinine |
0.865 |
0.854 |
0.875 |
meanMatrix <- cbind(ROCAUC[,1],CstatCI[,1],Sensitivity[,1],Specificity[,1])
colnames(meanMatrix) <- c("ROCAUC","C-Stat","Sen","Spe")
pander::pander(meanMatrix)
| age |
0.822 |
0.775 |
0.581 |
0.883 |
| kappa |
0.682 |
0.671 |
0.319 |
0.900 |
| lambda |
0.665 |
0.657 |
0.300 |
0.899 |
| creatinine |
0.594 |
0.589 |
0.288 |
0.865 |
Train Test Set
trainsamples <- sample(nrow(dataFL),0.5*nrow(dataFL))
dataFLTrain <- dataFL[trainsamples,]
dataFLTest <- dataFL[-trainsamples,]
pander::pander(table(dataFLTrain$status))
pander::pander(table(dataFLTest$status))
Test results
index <- predict(ml,dataFLTest)
rtestdata <- cbind(dataFLTest$status,ppoisGzero(index,h0))
rrAnalysisTest <- RRPlot(rtestdata,atRate=c(0.90,0.80),
timetoEvent=dataFLTest$time,
title="Train: Breast Cancer",
ysurvlim=c(0.00,1.0),
riskTimeInterval=timeinterval)






By Risk Categories on test set
obsexp <- rrAnalysisTest$OERatio$atThrEstimates
pander::pander(obsexp)
| Total |
1006 |
945 |
1070 |
1274 |
7.27e-15 |
| low |
278 |
246 |
313 |
340 |
5.73e-04 |
| 90% |
136 |
114 |
161 |
166 |
1.79e-02 |
| 80% |
594 |
547 |
644 |
767 |
9.83e-11 |
maxx <- 1.1*max(c(obsexp$Observed,obsexp$Expected))
minx <- 0.9*min(c(obsexp$Observed,obsexp$Expected))
plot(obsexp$Expected,obsexp$Observed,
xlim=c(minx,maxx),
ylim=c(minx,maxx),
main="Test: Expected vs Observed",
ylab="Observed",
xlab="Expected",
col=rainbow(nrow(obsexp)),
cex=1.5,
log="xy")
errbar(obsexp$Expected,obsexp$Observed,obsexp$L.CI,obsexp$H.CI,add=TRUE,pch=0,errbar.col=rainbow(nrow(obsexp)),cex=0.75)
lines(x=c(1,maxx),y=c(1,maxx),lty=2)
text(obsexp$Expected,obsexp$Observed,rownames(obsexp),pos=2,cex=0.75)

Cox Calibration
op <- par(no.readonly = TRUE)
calprob <- CoxRiskCalibration(ml,dataFLTrain,"status","time")
( 15.12552 , 17249.48 , 1.265159 , 953 , 1045.192 )
pander::pander(c(h0=calprob$h0,
Gain=calprob$hazardGain,
DeltaTime=calprob$timeInterval),
caption="Cox Calibration Parameters")
The RRplot() of the calibrated model
index <- predict(ml,dataFLTrain)
calrdata <- cbind(dataFLTrain$status,ppoisGzero(index,calprob$h0))
rrAnalysisCalTrain <- RRPlot(calrdata,atRate=c(0.90,0.80),
timetoEvent=dataFLTrain$time,
title="Cal. Train: Breast Cancer",
ysurvlim=c(0.00,1.0),
riskTimeInterval=calprob$timeInterval)






By Risk Categories
obsexp <- rrAnalysisCalTrain$OERatio$atThrEstimates
pander::pander(obsexp)
| Total |
953 |
893 |
1015 |
828 |
2.22e-05 |
| low |
257 |
227 |
290 |
225 |
3.58e-02 |
| 90% |
155 |
132 |
181 |
117 |
7.16e-04 |
| 80% |
542 |
497 |
590 |
485 |
1.10e-02 |
maxx <- 1.1*max(c(obsexp$Observed,obsexp$Expected))
minx <- 0.9*min(c(obsexp$Observed,obsexp$Expected))
plot(obsexp$Expected,obsexp$Observed,
xlim=c(minx,maxx),
ylim=c(minx,maxx),
main="Cal. Expected vs Observed",
ylab="Observed",
xlab="Expected",
col=rainbow(nrow(obsexp)),
cex=1.5,
log="xy")
errbar(obsexp$Expected,obsexp$Observed,obsexp$L.CI,obsexp$H.CI,add=TRUE,pch=0,errbar.col=rainbow(nrow(obsexp)),cex=0.75)
lines(x=c(1,maxx),y=c(1,maxx),lty=2)
text(obsexp$Expected,obsexp$Observed,rownames(obsexp),pos=2,cex=0.75)

Checking the test set
index <- predict(ml,dataFLTest)
rtestdata <- cbind(dataFLTest$status,ppoisGzero(index,calprob$h0))
rrAnalysisCalTest <- RRPlot(rtestdata,atRate=c(0.90,0.80),
timetoEvent=dataFLTest$time,
title="Cal. Test: Breast Cancer",
ysurvlim=c(0.00,1.0),
riskTimeInterval=calprob$timeInterval)






By Risk Categories test set
obsexp <- rrAnalysisCalTest$OERatio$atThrEstimates
pander::pander(obsexp)
| Total |
1006 |
945 |
1070 |
825 |
9.58e-10 |
| low |
278 |
246 |
313 |
220 |
1.82e-04 |
| 90% |
136 |
114 |
161 |
108 |
7.95e-03 |
| 80% |
594 |
547 |
644 |
496 |
1.97e-05 |
maxx <- 1.1*max(c(obsexp$Observed,obsexp$Expected))
minx <- 0.9*min(c(obsexp$Observed,obsexp$Expected))
plot(obsexp$Expected,obsexp$Observed,
xlim=c(minx,maxx),
ylim=c(minx,maxx),
main="Test Set. Expected vs Observed",
ylab="Observed",
xlab="Expected",
col=rainbow(nrow(obsexp)),
cex=1.5,
log="xy")
errbar(obsexp$Expected,obsexp$Observed,obsexp$L.CI,obsexp$H.CI,add=TRUE,pch=0,errbar.col=rainbow(nrow(obsexp)),cex=0.75)
lines(x=c(1,maxx),y=c(1,maxx),lty=2)
text(obsexp$Expected,obsexp$Observed,rownames(obsexp),pos=2,cex=0.75)
